MacWorld 1999 July

home *** CD-ROM | disk | FTP | other *** search

/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / Mops 3.4.sea / Mops source / PPC source / cg2 < prev next >

Wrap

Text File | 1998-11-06 | 45KB | 1,685 lines

marker m__cg2 PPC? [IF] false constant debug? false constant cascadeTest? [ELSE] false constant debug? false constant cascadeTest? [THEN] (* This file handles the basic arithmetic and logical stuff, including optimizations such as cascading (combining arithmetic ops) and strength reduction. Also branch resolution. *) (* CASCADE&MATCH? is called if we have an op which could possibly be combined with a preceding op - such a literal add where the other operand was also a literal add. If it makes sense to combine the ops into a single op we do so, by deleting the earlier op and suitably modifying the new one. After this we check for a match with a value already in the regs. If there's a match, we generate a new reference to the matching op (and so generate no code). In this case we return true to show that there's nothing more to do. Otherwise we return false. Note that a false return doesn't mean we didn't do a cascade - but in this case we completely handle the cascade here so don't need to notify the caller. On entry the new op we're looking at is in theOD. (We do it this way because we mightn't have allocated a register for it yet.) In the case where one operand is literal, it's always in B_opnd of theOD. If this is a fetch or store, it will actually be zero. We also assume references to the operands are in opnd1 and opnd2. The idea of this is that if we cascade or in some way change the operand reg(s), we'll change the corresponding reference, so the caller will free: the right reg when it's finished. *) 0 value antec# \ the reg# of the operand of the antecedent op, which \ might be deleted if we cascade. \ OK_for_cascade? runs a series of checks on the GPR whose number is in antec#, \ to see if a cascade is safe. It returns the appropriate flag. objPtr cas_regs class_is ODs_class : OK_FOR_CASCADE? { \ antecedentCDP -- b } antec# select: cas_regs \ select the operand GPR get: ivar> opCDP in cas_regs -> antecedentCDP false cascadeTest? if ." ok_for_cascade? called on:" print: cas_regs cr then \ we won't cascade if it would cross a basic block boundary - this would \ bristle with problems, so isn't worth worrying about. But note we \ ignore backstop_CDP here, since we're not doing any hoisting so \ checking for a BB boundary is sufficient. This also allows \ cascading to work at the start of defns, where the initial regs have \ zero in their opCDP fields, since we initialize basic_block_start to \ zero at the start of defns. get: ivar> opCDP in cas_regs basic_block_start u< ?EXIT \ we can't cascade an op on a special reg - if it is, presumably \ we need the result and can't tamper with it, regardless of its refcnt. get: ivar> special? in cas_regs ?EXIT \ and we can't cascade if the operand's refcnt is > 1 (which is *this* ref) - if \ there are any others, we need that result, so mustn't clobber that op. get: ivar> refcnt in cas_regs 1 > ?EXIT \ and we can't cascade if there was another use of that reg between its op and \ here - this is the same as an extra ref, except that it's already been retired. get: ivar> lastRefCDP in cas_regs get: ivar> opCDP in cas_regs u> ?EXIT \ and we can't cascade if one of the antecedent's operand regs has changed \ between there and here, which would prevent us validly recompiling here. Atype: cas_regs gprRef = IF Agpr: cas_regs select: cas_regs get: ivar> opCDP in cas_regs antecedentCDP u> antec# select: cas_regs \ restore selection ?EXIT THEN Btype: cas_regs GPRRef = IF Bgpr: cas_regs select: cas_regs get: ivar> opCDP in cas_regs antecedentCDP u> antec# select: cas_regs \ restore selection ?EXIT THEN \ if we got here, it's OK! drop true ; : CanBeMask? { litVal \ mEnd ones? n -- mBegin mEnd true | -- false } litVal NIF 0 0 true EXIT THEN litVal -1 = IF 0 31 true EXIT THEN \ they're the easy ones false -> ones? \ nothing scanned yet, or just 0's 31 -> n BEGIN litVal WHILE litVal 1 and NIF \ next bit is a zero ones? IF \ we were scanning ones and got a zero. There \ must be more ones left (or we wouldn't have \ continued the loop). So it's not a mask. false EXIT THEN ELSE \ next bit is a one ones? NIF \ we were scanning zeros and got a 1. Must be the \ first one, so we mark its position. n -> mEnd true -> ones? THEN THEN 1 --> n litVal 1 >> -> litVal REPEAT \ if we got here, it's OK as a mask. n is one less than the bit number \ of the first 1. n 1+ mEnd true ; : TRY_CASCADE_SHIFT&MASK { litVal \ mBegin mEnd -- b } false OK_for_cascade? 0EXIT litVal canBeMask? 0EXIT -> mEnd -> mBegin drop \ drop false flag cascadeTest? if ." cascading shift&mask on:" print: gprs ." lit val we're ANDing: $" litval .h cr cr then get: ivar> maskBegin in GPRs mBegin max -> mBegin get: ivar> maskEnd in GPRs mEnd min -> mEnd addr: GPRs ->: theOD mBegin put: ivar> maskBegin in theOD mEnd put: ivar> maskEnd in theOD [ cascadeTest? ] [if] ." new theOD:" print: theOD cr [then] noRef >refType: opnd1 \ opnd1 is now gone - reg mustn't get free: from caller true ; (* check_complemented_operand looks for situations where we can generate an andc or an orc by cascading an AND or OR with a preceding NOT. We can do this if they weren't immediate. But it has to be the B operand which gets complemented, so we switch them if necessary. *) : CHECK_COMPLEMENTED_OPERAND { \ complement? -- b } debug? if ." check_complemented_operand called" cr then false false -> complement? \ the A operand GPR is already selected get: ivar> opType in GPRs otNOT = IF true -> complement? Bgpr: theOD >Agpr: theOD \ Bgpr will be set below ELSE Bgpr: theOD select: GPRs get: ivar> opType in GPRs otNOT = IF true -> complement? current: GPRs -> antec# \ it's different now THEN THEN antec# select: GPRs \ normal selection complement? 0EXIT \ out if no NOT OK_for_cascade? 0EXIT \ or if NOT reg can't be deleted drop \ drop the false flag cascadeTest? if ." cascading NOT and AND/OR - deleting " current: GPRs . cr ." new OD in theOD:" print: theOD cr then Agpr: GPRs >Bgpr: theOD \ operand to be complemented not: ivar> complB? in theOD Agpr: theOD >gpr: opnd2 noRef >reftype: opnd1 \ only one reg to get free: from caller true ; : TRY_CASCADE_AND ( -- b ) Btype: theOD CASE[ litRef ]=> get: ivar> opType in GPRs otShift&mask = IF Blit: theOD try_cascade_shift&mask ELSE false THEN [ gprRef ]=> check_complemented_operand DEFAULT=> drop false ]CASE ; : TRY_CASCADE_OR ( -- b ) Btype: theOD gprRef = NIF false EXIT THEN check_complemented_operand ; (* try_cascade_not checks for situations where we can generate a nand or a nor, by cascading a NOT with a preceding AND, OR or XOR. We can do this if they weren't immediate. *) : TRY_CASCADE_NOT { \ prevOp -- b } false get: ivar> complB? in GPRs ?EXIT \ or if it's an andc or orc (can't complement \ the result - we don't have "nandc" or "norc") Agpr: theOD select: GPRs get: ivar> opType in GPRs -> prevOp \ grab preceding op prevOp otAND = prevOp otOR = or prevOp otXOR = or 0EXIT \ out if wrong sort Atype: GPRs gprRef = 0EXIT \ out if either of its operands wasn't Btype: GPRs gprRef = 0EXIT \ a GPR drop \ OK, we'll do it. Drop false flag current: GPRs -> antec# \ may have changed [ cascadeTest? ] [if] ." cascading NOT with earlier op:" print: gprs ." theOD:" print: theOD cr cr [then] addr: GPRs ->: theOD \ copy op to theOD (which is where we need it) not: ivar> complResult? in theOD \ and set "complement result" flag noRef >refType: opnd1 \ opnd1 is now gone - reg mustn't get free: from caller true ; : TRY_CASCADE_ADD { op \ litVal Btype -- b } false Btype: theOD litRef = 0EXIT \ out if this op not literal get: ivar> opType in GPRs otAdd = 0EXIT \ or if prev op not add OK_for_cascade? 0EXIT \ or if GPR op can't be deleted Blit: theOD -> litVal Btype: GPRs -> Btype op otAdd = IF \ and if THIS op is add, the other add must Btype litRef <> ?EXIT \ be literal. ELSE \ For fetch or store, we can add 2 regs, since indexed mode exists, but \ the literal we're adding must be zero. Note the only possibility \ that can come up here is the antecedent op adding 2 regs, and this \ op fetching/storing using the result reg and a literal zero. The \ antecedent op can't be a literal add of zero, since we never compile \ those! Btype gprRef = IF litVal ?EXIT ELSE Btype litRef <> ?EXIT THEN THEN get: ivar> special? in GPRs ?EXIT \ and only on a temp register - if on another \ another reg, we need the value, so can't \ delete the op. \ Right, if we got here we'll do the cascade! drop \ drop false flag cascadeTest? if ." cascading adds on:" print: gprs ." lit val we're adding: " litval . cr ." theOD:" print: theOD cr cr then Btype: GPRs GPRRef = IF Bgpr: GPRs >Bgpr: theOD noRef >refType: opnd2 ELSE Blit: GPRs ++> litVal \ new literal value litVal >Blit: theOD THEN Agpr: GPRs >Agpr: theOD noRef >refType: opnd1 \ opnd1 is now gone - reg mustn't get free: from caller true ; : TRY_CASCADE_FMADD { op \ doit? subop add_fpr# ^ref_to_clear -- b } false -> doit? multiply-add? NIF false EXIT THEN \ out if we're not doing it FPRs -> cas_regs nilP -> ^ref_to_clear op otFsub = if 1 else 0 then -> subop \ note: we need to check both the A and B operands of this op. If either \ is a multiply, we might be able to generate a fmadd. Areg: theOD dup -> antec# select: FPRs cascadetest? if ." try_cascade_fmadd here." cr ." theOD:" print: theOD cr ." Looking for 42 (otFmul) in A opnd FPR:" print: FPRs cr dasm then get: ivar> opType in FPRs otFmul = IF OK_for_cascade? IF get: ivar> special? in FPRs NIF true -> doit? Breg: theOD -> add_fpr# opnd1 -> ^ref_to_clear THEN THEN THEN doit? NIF \ can't do it on the A operand - let's try B... Bfpr: theOD dup -> antec# select: FPRs cascadetest? if ." trying B opnd FPR:" print: FPRs cr then get: ivar> opType in FPRs otFmul = IF OK_for_cascade? IF get: ivar> special? in FPRs NIF \ yep, we can do it, but if it's mult-and-subtract, \ the operands are reversed. true -> doit? subop 2* -> subop Areg: theOD -> add_fpr# opnd2 -> ^ref_to_clear THEN THEN THEN THEN doit? NIF false EXIT THEN \ out with false if we can't do it at all \ Right, if we got here we'll do the cascade! cascadeTest? if ." cascading floating mult and add on:" print: fprs then Areg: FPRs >Afpr: theOD Breg: FPRs >Bfpr: theOD \ these operands get multiplied add_fpr# >Cfpr: theOD \ this one gets added/subtracted otFmadd put: ivar> opType in theOD subop put: ivar> subtype in theOD cascadetest? if ." theOD as set up for fmadd:" print: theOD cr ." setting this operand ref to noRef: " print: [ ^ref_to_clear ] cr then noRef ^ref_to_clear >refType: class_as> reference \ either opnd1 or opnd2 is now gone - reg mustn't get free: from caller true ; : TRY_CASCADE { \ op atype -- } cascade? 0EXIT \ straight out if cascading turned off GPRs -> cas_regs \ normal default cascadeTest? if ." try_cascade called with theOD:" print: theOD cr then get: ivar> opType in theOD -> op \ op is the new op we're compiling \ first we won't cascade if we're not handling that reg type: Atype: theOD -> atype atype gprRef = IF \ we set the A operand as the initial default for the reg we'll replace \ if we cascade, but we won't check it yet since it might be a GPR-GPR \ op and we might end up cascading on the other operand. Agpr: theOD dup -> antec# select: GPRs ELSE atype fprRef = 0EXIT \ out if not gprRef or fprRef THEN op $ 2FF and \ we want to include FP fetches with integer \ fetches, but not vector fetches! SELECT[ otAdd ], [ otFetch ], [ otStore ]=> op try_cascade_add [ otAnd ]=> try_cascade_and [ otOr ]=> try_cascade_or [ otNot ]=> try_cascade_not [ otFadd ], [ otFsub ]=> op try_cascade_fmadd \ can change cas_regs to FPRs DEFAULT=> drop false ]SELECT cascadeTest? if cr ." checking for cascade returns " dup . cr then antec# select: cas_regs \ antec# might have changed. This should be \ redundant, but you never know. cascadeTest? if dup if ." deleting: " print: cas_regs cr ." new OD in theOD" print: theOD cr then then IF delete: cas_regs THEN \ if we cascaded, we delete the op we've made \ redundant ; : CASCADE&MATCH? try_cascade \ do the cascade if we can (and if we did, \ theOD will have been appropriately modified true match&allocate? get: ivar> opType in theOD -> operation get: ivar> subtype in theOD -> suboperation cascadeTest? if ." calling match&allocate? returns " dup . cr then ; (* STRENGTH_REDUCE? is called if we have an op where one of the operands is literal. We may be able to strength-reduce the op to something simpler. Currently we just do one: if the op is a multiply, and the literal is a power of 2, we convert it to a shift. If we change the op, we then, as usual, check for a match with an op already in the regs. If there's a match, we return true to show that there's nothing more to do. Otherwise we return false. *) : STRENGTH_REDUCE? { \ litVal #bits n -- } operation otMul <> IF false EXIT THEN Blit: theOD -> litVal 0 -> #bits -1 -> n litVal 0<= IF false EXIT THEN BEGIN litVal WHILE litVal 1 and ++> #bits 1 ++> n litVal 1 >> -> litVal REPEAT #bits 1 <> IF false EXIT THEN \ yes, it's a power of 2 - n gives the power. otShift -> operation 0 -> subOperation operation put: ivar> opType in theOD subOperation put: ivar> subType in theOD n >Blit: theOD true match&allocate? IF true ELSE false THEN ; (* RegLit_as_2_instrns? is called from CompRegLit if the literal is > 16 bits. We see if it can be done as one or two instructions. For AND, OR and XOR, the andi, ori and xori instructions have shifted forms, which means that we can do the op in 2 instructions, or 1 if the lower 16 bits are zero. For ADD, if the literal value isn't too large, we can do the op as two literal adds. If we can do one of these optimizations, we do it here and return true. Otherwise we return false. On entry, we've already allocated a result reg and res1 is a reference to it. If we return true, we might have found a match, and in that case we make sure res1 indicates the new result, and we free the old result reg. Special note: if we need 2 instructions, we have a choice: A. Generate the ops using 2 separate registers B. Reuse the one reg. Under A, we would call compile: GPRs twice, targetting a different GPR. Under B, we could handle the whole thing in the compile: method of OD, and only call it once from here. There are pros and cons either way. B is a bit simpler. But for ADD, we'll often get called for address generation where the target addresses have a lot of locality, and we might be able to re-use intermediate values if we use A and do it a bit cleverly. But for the logicals, we're much less likely to be able to reuse the intermediate values and so we'd be using an extra register for nothing. So we'll use A for ADD, and B for the logicals. *) : RegLit_as_2_instrns? { litVal \ op n1 n2 dest_gpr# temp_gpr# -- b } false refType: opnd1 GPRref <> ?EXIT \ can't do it if it's not a GPR->GPR op refType: res1 GPRref <> ?EXIT operation -> op reg: res1 -> dest_gpr# 0 -> temp_gpr# op otAND = IF \ we can do it for AND iff the lo 16 bits are zero litVal $ FFFF and ?EXIT \ out if they're not true ELSE op otOR = op otXOR = or \ we can always do it for OR and XOR THEN IF \ it's a logical op and we're to use plan B 0 -> n1 litVal -> n2 ELSE op otAdd = 0EXIT \ out if op isn't add (no literal subtract) litVal 2/ $ fffffc00 and -> n1 \ halve the literal & round down to \ 1024-byte boundary to increase \ chance of a match later n1 true 16bits? nip 0EXIT \ if THAT won't fit in 16 bits, nogo litVal n1 - -> n2 \ subtract that from orig literal n2 true 16bits? nip 0EXIT \ if that won't fit in 16 bits, nogo THEN \ if we got here, we can do it! drop true \ we'll be returning true n1 IF \ we only do this for ADD (plan A) n1 >Blit: theOD true match&allocate? IF current: GPRs -> temp_gpr# ELSE getFreeReg: GPRs -> temp_gpr# theOD ->: GPRs compile: GPRs \ compile the 1st op THEN temp_gpr# >Agpr: theOD \ result of 1st op is source for 2nd THEN n2 >Blit: theOD true match&allocate? IF \ match on 2nd op - res1 now points \ to the new result. dest_gpr# select: GPRs free: GPRs ELSE dest_gpr# dup select: GPRs >gpr: res1 \ res1 may have been changed by \ the first match&allocate? call theOD ->: GPRs compile: GPRs THEN \ finally, whether anything matched or not, we have to free the \ intermediate reg, if there was one: temp_gpr# ?dup IF select: GPRs free: GPRs THEN ; : compCRCR debug? if ." compCRCR called to compile a CR op. theOD:" cr print: theOD then false 0 0 CR_result theOD ->: CRs compile: CRs cmpLT >condition: res1 \ it's fairly arbitrary, actually, but must agree with what we \ put ihto rD. Easiest is bit# 0, 1 is true, which means \ "less than", so that's what we use. ; \ compRegReg factors out some common code from dyadic_arith and monadic_arith. \ theOD is set up with the new op we're about to compile. : compRegReg true match&allocate? ?EXIT \ if it matches a result we already \ have, we reuse it cascade&match? ?EXIT \ If we can cascade it with a preceding \ op, we do it and we're done \ now one or both operands might be in CRs, so we have to check. debug? if ." compRegReg - match&allocate? and cascade&match?" cr ." both returned false. TheOD:" print: theOD cr then Atype: theOD fprRef = IF 1 fresults ELSE Atype: theOD gprRef = IF Btype: theOD dup gprRef = swap noRef = or NIF Bref: theOD get_to_gpr? IF \ changed, so we update opnd2 so it gets \ freed properly by the caller. New ref is \ always left in res1 by get_to_gpr? res1 ->: opnd2 THEN THEN ELSE Btype: theOD dup gprRef = swap noRef = or IF Aref: theOD get_to_gpr? IF res1 ->: opnd1 THEN ELSE compCRCR EXIT THEN THEN \ if we got here, both operands are in regs, even if they weren't \ to start with. 1 results THEN theOD ->: theRegs compile: theRegs ; (* compRegLit is a lot more complicated. It's called from several places where we're doing a dyadic op where one operand is literal. There are a lot of possible optimizations. Unlike compRegReg, theOD is not set up yet, since we have to do some checks first. We enter with the lit in opnd2, and the other operand is opnd1. We leave res1 indicating the result. Note that we allocate the result reg fairly early, and set up res1, which means that if we later find a match or change the result reg for some reason, we need to free: res1. *) objPtr OP_resultReg class_is OD : compRegLit { \ reg# litVal sgnd? comp? -- } lit: opnd2 -> litVal clear: theOD operation put: ivar> opType in theOD subOperation put: ivar> subType in theOD operation dup signed? -> sgnd? dup otCMP = swap otUCMP = or -> comp? debug? if cr ." compRegLit - " cr ." opnd1 " print: opnd1 ." litVal " litVal . ." sgnd? " sgnd? . ." comp? " comp? . cr ." operation " operation .h cr printall: cstk then \ First, there's no literal divide or multiply high instruction - so if \ we have this, we need to load the literal into a reg and change to \ a reg-reg op. operation otDiv = operation otUDiv = or operation otMulh = or IF theOD copyOD: tmpOD litVal false lit>gpr tmpOD copyOD: theOD opnd1 ->: ivar> A_opnd in theOD res1 ->: ivar> B_opnd in theOD \ this was set by lit>gpr compRegReg EXIT THEN \ Next, there's no literal subtract instruction - so in this case \ we need to negate the literal value and change the op to add. operation otSub = IF neg> litVal otAdd -> operation THEN operation put: ivar> opType in theOD \ may not have been set up, and \ in any case may have changed reg: opnd1 -> reg# \ may be a gpr or cr reference litVal >BLit: theOD \ Now, we can get rid of some trivial cases. Object binding and inline \ definitions can produce things like 0 + or -1 AND for which we don't \ have to generate any code. For these, we just set res1 and get out. \ The res1 result is either a literal -1 or 0, or it's a copy of opnd1. \ In the cases where we transfer opnd1 to res1, we clear opnd1 so that \ its register doesn't get freed (we're still using it, of course). operation otAnd = IF litval NIF debug? if ." anding zero - replacing with zero" cr then 0 >lit: res1 free: opnd1 delete: opnd1 EXIT ELSE litval -1 = IF debug? if ." anding -1 - moving opnd1 to res1" cr then opnd1 ->: res1 clear: opnd1 EXIT THEN THEN THEN operation otOr = IF litval NIF debug? if ." oring 0 - moving opnd1 to res1" cr then opnd1 ->: res1 clear: opnd1 EXIT ELSE litval -1 = IF debug? if ." oring -1 - replacing with -1" cr then -1 >lit: res1 free: opnd1 delete: opnd1 EXIT THEN THEN THEN operation otAdd = IF debug? if ." adding 0 - moving opnd1 to res1" cr then litval NIF opnd1 ->: res1 clear: opnd1 EXIT THEN THEN \ Next, if the operation is And, and the literal could be a mask, we \ can replace the And with a rotate left (by zero) and mask. This \ doesn't involve accessing the CR, unlike andi., so it's recommended \ we do it. refType: opnd1 SELECT[ gprRef ]=> reg# >Agpr: theOD true match&allocate? ?EXIT \ if it already exists, we're done. cascade&match? ?EXIT \ if we cascaded and it already exists Blit: theOD -> litVal \ may have changed Agpr: theOD >gpr: opnd1 \ likewise strength_reduce? ?EXIT \ if we strength-reduced & it alr exists [ CRref ]=> \ CR - lit operation - normally we'll have to \ get the CR to a GPR first. The only exceptions \ are the degenerate cases where the op is a logical \ or comparison, and the lit is -1 or 0. At the \ moment we won't bother with these optimizations \ (which would probably be pretty rare anyway). reg# >Acr: theOD true match&allocate? ?EXIT \ if it already exists, we're done. opnd1 cr>gpr res1 ->: opnd1 \ cr>gpr frees the CR debug? if ." opnd1 is CR - converted to: " print: opnd1 cr then gpr: opnd1 dup -> reg# >Agpr: theOD DEFAULT=> to_be_written drop ]SELECT false -> check_OP_stores? \ we must have this checking turned \ off, since large_obj_array elements \ don't have class pointers comp? IF false 0 0 CR_result \ for comparisons, dest is a CR. Get a CR result reg addr: CRs -> OP_resultReg litVal sgnd? 16bits? nip IF theOD ->: CRs compile: CRs EXIT THEN ELSE 1 results \ get a GPR result reg addr: GPRs -> OP_resultReg debug? if ." result reg will be " print: gprs cr then \ now if the op is And, and the literal could be a mask \ for a rotate left and mask instruction, it's better if we \ use that (with a zero rotate), since it doesn't store to \ the condition reg (unlike andi.). operation otAnd = IF litVal canBeMask? IF theOD ->: GPRs otShift&mask put: ivar> opType in GPRs put: ivar> maskEnd in GPRs put: ivar> maskBegin in GPRs 0 >lit: ivar> B_opnd in GPRs \ rotate by 0 compile: GPRs EXIT THEN THEN litVal sgnd? 16bits? nip IF theOD ->: GPRs compile: GPRs debug? if ." just compiled this reg:" print: GPRs printall: cstk then EXIT THEN THEN (* If we got to here, the literal was >16 bits. We may have to load the long literal into a register, then do a 2-reg op. This will take a total of 3 instructions. But there are some other things we can try - if the operation is add, and, or or xor, we may be able to do the op in 1 or 2 instructions. We handle this in regLit_as_2_instrns?. Note that at this point we've allocated the result reg, and it's selected in GPRs. If we match on a value in another reg, we'll have to free the result reg we have now. *) (* operation otAnd = IF litVal canBeMask? IF theOD ->: GPRs otShift&mask put: ivar> opType in GPRs put: ivar> maskEnd in GPRs put: ivar> maskBegin in GPRs 0 >lit: ivar> B_opnd in GPRs \ rotate by 0 compile: GPRs EXIT THEN THEN *) litVal regLit_as_2_instrns? ?EXIT \ if we did it, we're done \ Right, we have to compile a load of the long literal into a reg, then use the \ reg. This case then becomes like a normal 2-reg op (see below) litVal setLit: theOD theOD true match? IF drop debug? if ." long lit matched on:" print: GPRs .s then allocate: GPRs current: GPRs dup -> reg# >GPR: opnd2 ELSE getFreeReg: GPRs \ get reg we're going to load into theOD ->: GPRs dup -> reg# >GPR: opnd2 compile: GPRs \ compile load of the long lit THEN debug? if ." long lit was loaded - res1 before compiling op:" print: res1 cr ." result reg:" print: OP_resultReg cr .s then gpr: opnd1 >Agpr: OP_resultReg reg# >Bgpr: OP_resultReg operation put: ivar> opType in OP_resultReg compile: OP_resultReg gpr: opnd2 select: GPRs free: GPRs \ free the temp reg we used for the lit ; \ nonCom_litReg is called from dyadic_arith when the first operand is literal \ and the second is in a register, and the op is non-commutative so we can't \ just swap the operands. We load the literal into a reg and do a reg-reg op. \ (The code is similar to that near the start of compRegLit above, when we \ handle an operation that doesn't have a literal instruction.) : NONCOM_LITREG { \ litVal -- } lit: opnd1 -> litVal theOD copyOD: tmpOD litVal false lit>gpr tmpOD copyOD: theOD res1 ->: ivar> A_opnd in theOD \ this was set by lit>gpr opnd2 ->: ivar> B_opnd in theOD compRegReg ; : COMMUTATIVE? ( op -- b ) CASE[ otSub ], [ otDiv ], [ otUDiv ], [ otShift ], [ otShift&mask ], [ otTrap ]=> false DEFAULT=> drop true ]CASE ; : FP_DYADIC_ARITH FPRs -> theRegs 2 foperands opnd1 ->: ivar> A_opnd in theOD opnd2 ->: ivar> B_opnd in theOD compRegReg free: opnd1 free: opnd2 res1 fpush GPRs -> theRegs \ normal default - might be best to put it back debug? if ." fp_dyadic_arith finished:" cr ." cstk: " printall: cstk cr ." cstk2: " printall: cstk2 cr ." fcstk: " printall: fcstk cr ." fcstk2:" printall: fcstk2 cr dasm then ; : FP_MONADIC_ARITH FPRs -> theRegs 1 foperands opnd1 ->: ivar> A_opnd in theOD compRegReg free: opnd1 res1 fpush GPRs -> theRegs \ normal default - might be best to put it back debug? if ." fp_monadic_arith finished:" cr ." cstk: " printall: cstk cr ." cstk2: " printall: cstk2 cr ." fcstk: " printall: fcstk cr ." fcstk2:" printall: fcstk2 cr dasm then ; : DYADIC_ARITH debug? if cr ." dyadic_arith -" cr ." operation " operation .h ." subOperation " subOperation .h cr printall: cstk then GPRs -> theRegs clear: instrn clear: theOD operation put: ivar> opType in theOD subOperation put: ivar> subType in theOD operation otFPstart >= IF FP_dyadic_arith EXIT THEN 2 operands refType: opnd1 dup litRef > IF 221 die THEN \ "Impossible operand!" litRef = negate 2* refType: opnd2 dup litRef > IF 221 die THEN litRef = negate or SELECT[ 0 ]=> \ Both operands are regs opnd1 ->: ivar> A_opnd in theOD opnd2 ->: ivar> B_opnd in theOD compRegReg [ 1 ]=> \ 1st op reg, 2nd lit compRegLit [ 2 ]=> \ 1st op lit, 2nd reg. If the op is commutative, we can \ just swap the operands and call compRegLit. If it's \ subtract, we can change it to subfic and do the same \ thing. Otherwise we have to do a bit more juggling so \ we call nonCom_litReg to handle it. operation otSub = IF otSubfc -> operation true ELSE operation commutative? THEN IF opnd1 ->: res3 opnd2 ->: opnd1 res3 ->: opnd2 compRegLit ELSE nonCom_litReg THEN [ 3 ]=> \ Both lit - execute the op right now! lit: opnd1 lit: opnd2 operation subOperation getImmediateOp execute >lit: res1 DEFAULT=> drop ]SELECT free: opnd1 free: opnd2 res1 push true -> check_OP_stores? \ may have been turned off ; : MONADIC_ARITH debug? if cr ." monadic_arith -" cr ." operation " operation .h ." subOperation " subOperation .h cr printall: cstk then GPRs -> theRegs clear: instrn clear: theOD operation put: ivar> opType in theOD subOperation put: ivar> subType in theOD operation otFPstart >= IF FP_monadic_arith EXIT THEN 1 operands refType: opnd1 litRef > IF 221 die THEN \ "Impossible operand!" opnd1 ->: ivar> A_opnd in theOD true match&allocate? ?EXIT \ if it matches a result we already \ have, we reuse it cascade&match? ?EXIT \ If we can cascade it with a preceding \ op, we do it and we're done refType: opnd1 SELECT[ gprRef ]=> gpr: opnd1 >Agpr: theOD compRegReg [ fprRef ]=> to_be_written [ CRref ]=> operation otNOT = IF \ we can use a CR op compCRCR \ this does everything res1 push EXIT ELSE opnd1 get_to_gpr? drop THEN gpr: opnd1 >Agpr: theOD compRegReg [ litRef ]=> \ execute the op right now! lit: opnd1 operation subOperation getImmediateOp execute >lit: res1 DEFAULT=> ]SELECT free: opnd1 res1 push true -> check_OP_stores? \ may have been turned off ; : special_arith? \ handles things like subfze. We only include the ones we \ actually want. Also, as we're only generating them \ internally, we can kludge a bit, and assume the \ operands are of the right sort. We'll just get an error \ if they're not, which won't affect users. operation \ SELECT[ otAddic ], \ [ otSubfic ]=> 1 operands \ litref >reftype: opnd1 \ shd always be literal \ opnd1 push dyadic_arith true SELECT[ otAddze ], [ otAddme ], [ otSubfze ], [ otSubfme ]=> 0 >gpr: res1 res1 push dyadic_arith true \ [ otAddc ], \ [ otAdde ], \ [ otSubfc ], \ [ otSubfe ]=> DEFAULT=> drop false ]SELECT ; : DO_ARITH_OP special_arith? ?EXIT \ out if it was special, and we handled it operation monadic? nip IF monadic_arith ELSE dyadic_arith THEN ; : GENERATE_CR_RESULT { \ reg# cr# wantit? xx -- } 0 -> cr# false -> wantit? Atype: theOD FPRref = IF 1 -> cr# THEN reg: ivar> A_opnd in theOD dup -> reg# select: theRegs (* We first see if we can avoid a cmp by modifying the antecedent op to set CR0 (or CR1 if it's FP). This situation is a bit like cascading, but a bit different too. The main difference is that if we modify the antecedent to set CR0, we haven't actually changed its result, so its refcnt and other uses of that reg don't matter. But we do still have to check for a basic block boundary, since we can't rely on CR0 still being valid over such a boundary - in fact, it generally won't be. *) get: ivar> opCDP in theRegs basic_block_start u>= \ there's no BB boundary - if there is, we \ can't optimize to use CR0/1, regardless IF get: ivar> instrnType in theRegs SELECT[ arithType ], [ logicalType ]=> \ OK unless literal Btype: theRegs litRef <> [ shiftType ]=> \ always OK true DEFAULT=> drop false ]SELECT -> wantit? \ but there's one special exception - literal AND ( andi. ) always sets CR0 \ no matter what! Note, if we're in the FPRs, the op won't ever be otAnd, \ but the following test is still valid so we don't need to check for this case. wantit? NIF get: ivar> opType in theRegs otAnd = Btype: theRegs litRef = and -> wantit? THEN THEN wantit? cr# get: ivar> opCDP in theRegs CR_result current: CRs cr# = wantit? and IF \ we can set the CR field by recompiling the op setCR: theRegs recompile: theRegs get: ivar> opCDP in theRegs mark_use: theRegs \ that was an implicit reference to that reg ELSE \ we have to compile a cmp theOD ->: CRs compile: CRs THEN ; (* modify_condition is called when a monadic condition reference references another condition reference (e.g. ... < 0= - doesn't look very logical, but inline code could cause this to happen). The initial ref is in opnd1, and the conditional op is in subOperation. The result ref goes into res1. The situation we're modelling is that the first op has left a flag on the data stack, which of course is -1 or 0. So the possible transformations are: 1st op monadic op result -1 0<> -1 0= 0 0>= 0 0< -1 0<= -1 0> 0 0 0<> 0 0= -1 0>= -1 0< 0 0<= -1 0> 0 That is, the condition is simply inverted for all ops except 0<= and 0>, which are left unchanged. *) : MODIFY_CONDITION addr: opnd1 ->: res1 suboperation cmpZLE = suboperation cmpZGT = or ?EXIT not: ivar> 1_is_true? in res1 ; : DYADIC_COMPARISON \ ( unsigned? -- ) \ Note: operation not set up yet. The comparison code is in \ subOperation. debug? if ." dyadic_comparison -" cr ." subOperation " subOperation .h cr then GPRs -> theRegs clear: instrn clear: theOD IF otUCMP ELSE otCMP THEN dup -> operation put: ivar> opType in theOD subOperation put: ivar> subtype in theOD 2 operands refType: opnd1 litRef = negate 2* refType: opnd2 litRef = negate or SELECT[ 0 ]=> \ Both operands are regs (GPR or CR) opnd1 get_to_gpr? drop opnd2 get_to_gpr? drop gpr: opnd1 >Agpr: theOD gpr: opnd2 >Bgpr: theOD theOD true match?: CRs IF allocate: CRs current: CRs >CR: res1 subOperation >condition: res1 res1 ->: ivar> myRef in CRs ELSE false 0 0 CR_result theOD ->: CRs compile: CRs THEN [ 1 ]=> \ 1st op reg, 2nd lit compRegLit [ 2 ]=> \ 1st op lit, 2nd reg reverse_comparison opnd1 ->: res3 opnd2 ->: opnd1 res3 ->: opnd2 compRegLit [ 3 ]=> \ Both lit lit: opnd1 lit: opnd2 operation subOperation getImmediateOp execute >lit: res1 DEFAULT=> drop ]SELECT free: opnd1 free: opnd2 res1 push true -> check_OP_stores? \ may have been turned off ; : MONADIC_COMPARISON \ ( unsigned? -- ) \ Note: operation not set up yet. The comparison code is in \ subOperation. GPRs -> theRegs clear: instrn clear: theOD IF otUCMP ELSE otCMP THEN dup -> operation put: ivar> opType in theOD subOperation put: ivar> subtype in theOD 0 >Blit: theOD \ second operand is literal zero 1 operands refType: opnd1 SELECT[ gprRef ]=> \ operand is in a gpr gpr: opnd1 >Agpr: theOD true match&allocate? NIF generate_CR_result THEN [ crRef ]=> \ operand is in a cr so the test has been done - we \ can just modify the existing reference \ appropriately modify_condition res1 push EXIT [ litRef ]=> \ execute the op right now! lit: opnd1 operation subOperation getImmediateOp execute >lit: res1 DEFAULT=> drop ]SELECT free: opnd1 res1 push ; : FP_DYADIC_COMPARISON debug? if ." fp_dyadic_comparison -" cr ." subOperation " subOperation .h cr then FPRs -> theRegs clear: instrn clear: theOD otFPcmp dup -> operation put: ivar> opType in theOD subOperation put: ivar> subtype in theOD 2 foperands opnd1 ->: ivar> A_opnd in theOD opnd2 ->: ivar> B_opnd in theOD theOD true match?: CRs IF allocate: CRs current: CRs >CR: res1 subOperation >condition: res1 res1 ->: ivar> myRef in CRs ELSE false 0 0 CR_result theOD ->: CRs compile: CRs THEN free: opnd1 free: opnd2 res1 push true -> check_OP_stores? \ may have been turned off GPRs -> theRegs \ normal default - might be best to put it back debug? if ." fp_dyadic_comparison finished:" cr ." cstk: " printall: cstk cr ." cstk2: " printall: cstk2 cr ." fcstk: " printall: fcstk cr ." fcstk2:" printall: fcstk2 cr dasm then ; : FP_MONADIC_COMPARISON debug? if ." fp_monadic_comparison -" cr ." subOperation " subOperation .h cr then FPRs -> theRegs clear: instrn clear: theOD otFPcmp dup -> operation put: ivar> opType in theOD subOperation put: ivar> subtype in theOD 1 foperands fpr: opnd1 >Afpr: theOD true match&allocate? NIF generate_CR_result THEN free: opnd1 res1 push true -> check_OP_stores? \ may have been turned off GPRs -> theRegs \ normal default - might be best to put it back debug? if ." fp_monadic_comparison finished:" cr ." cstk: " printall: cstk cr ." cstk2: " printall: cstk2 cr ." fcstk: " printall: fcstk cr ." fcstk2:" printall: fcstk2 cr dasm then ; : SETUP_CONDITIONAL_BRANCH { ^ref invert? \ whichBit -- } false -> check_OP_stores? \ may be a reference_list instead of a reference, ^ref -> aRef \ so we bypass the type check. true -> check_OP_stores? debug? if ." setup_conditional_branch called with " print: aRef cr then 16 >primOp: branch_instrn refType: aRef CRref <> IF ." ref passed to setup_conditional_branch not a CR ref" cr print: aRef 1 die THEN reg: aRef 4* bit#: aRef or -> whichBit true put: ivar> use_cond? in branch_instrn 1_is_true?: aRef invert? xor put: ivar> branchOn1? in branch_instrn whichBit >RA: branch_instrn ; \ : SETUP_UNCONDITIONAL_BRANCH \ 18 >primOp: uncond_branch_instrn \ 0 >lit: branch_instrn \ for now - will be patched \ ; : COMPILE_UNCONDITIONAL_BRANCH \ setup_unconditional_branch \ compile: uncond_branch_instrn $ BF080000 code, ; (* COMBINE_BRANCHES is called when we have a conditional branch over a single unconditional branch or EXIT. We can usually combine these into a single conditional branch. Note that a normal uncond. branch has the temp opcode BF08, an ELSE- branch has BF09, and an EXIT has BF02. We don't use temp opcodes for conditional branches, so if we combine the branches and it's not an EXIT, we just emit a regular conditional branch. branchCDP is the addr of the 1st of the 2 branches. Note we only call this routine if the first branch is conditional. An ELSE branch can occur over another branch, but we handle that below in RESOLVE_ELSE. This also means we can assume here that branch_instrn is set up for the conditional branch, so we can easily invert the condition and recompile it. *) : COMBINE_BRANCHES { branchCDP \ svCDP offs len -- } debug? if ." combine_branches called - there's a branch over " then CDP -> svCDP branchCDP 4+ w@ CASE[ $ BF02 ]=> \ it's an EXIT - marked by temp opcode BF02 \ until resolved at the end of the definition. We \ convert it to a conditional exit (opcode BF03). debug? if ." an EXIT" cr then branchCDP -> CDP invert: branch_instrn compile: branch_instrn branchCDP @ 16 >> $ BF030000 or branchCDP ! EXIT [ $ BF08 ], [ $ BF09 ]=> \ uncond branch / ELSE-branch debug? if ." an uncond. branch" cr then branchCDP 2+ w@x -> offs offs 0EXIT \ 2nd branch not resolved yet - can't combine DEFAULT=> ]CASE \ We'll combine. We need to retain the offset since we're going to \ move any following code to fill the gap, so the offset will stay \ the same. branchCDP -> CDP invert: branch_instrn compile: branch_instrn \ branchCDP branchCDP 4+ offs + resolve_branch offs branchCDP 2+ w! \ now if there's any code between that collapsed branch and the present \ CDP position, we have to move it back by 4 bytes. \ ASSERT: there won't be a resolved branch pointing to anywhere in \ the middle of the code we're moving! svCDP branchCDP 4+ - -> len len 0> IF branchCDP 8 + dup 4- len move \ areas overlap, so don't use \ aligned_move svCDP 4- ELSE svCDP THEN -> CDP ; : RESOLVE_ELSE { branchCDP destCDP \ offs condCDP len wipeBoth? -- } destCDP branchCDP - -> offs offs 4 = IF \ this is a branch to the next instruction - \ maybe we can just omit it altogether. destCDP CDP = optimize_branches? and IF debug? if ." ELSE branch over nothing - deleting it" cr then \ we pick up the offset to the original conditional branch and \ subtract 4 since we're deleting this branch. -4 branchCDP 2+ w@x branchCDP + 2+ w+! -4 ++> CDP EXIT \ wipe out the branch, and we're done THEN THEN \ now we check if we're branching over another branch. In this case, \ we can get rid of both of them! false -> wipeBoth? offs 8 = optimize_branches? and IF branchCDP 4+ w@ \ these are the opcodes for our various \ kinds of unconditional branches: CASE[ $ BF02 ], \ EXIT [ $ BF08 ], \ normal uncond. branch [ $ BF09 ]=> \ ELSE-branch debug? if ." ELSE branch over another branch - deleting both." cr ." Here's the code before we do:" cr dasm then true -> wipeBoth? DEFAULT=> drop ]CASE THEN \ now if we're compiling the ELSE branch, we resolve it and we're done. wipeBoth? NIF offs $ FFFFFFFC and \ %%%%temp while we're testing branchCDP 2+ w! EXIT THEN \ if we got here, we're omitting both the ELSE and the following \ branch. \ First we pick up the offset to the original conditional branch, \ work out where it is, and compute the new offset to put in it, \ so that it will branch to the target location of the following \ branch, which is where it's going anyway. Note we must allow \ for the removal of the two branches, by reducing the offset by 8. branchCDP 2+ w@x branchCDP + -> condCDP branchCDP 6 + w@ \ offs to target, rel to branchCDP + 4 branchCDP condCDP - + 4- \ new offs, with 8 subtracted condCDP 2+ w! \ If there's any code to move, we move it back by 8 bytes. \ ASSERT: there won't be a resolved branch pointing to anywhere in \ the middle of the code we're moving! CDP branchCDP 8 + - -> len len 0> IF branchCDP 8 + dup 8 - len move \ areas overlap, so don't use THEN \ aligned_move 8 --> CDP ; : RESOLVE_BRANCH { branchCDP destCDP \ offs -- } branchCDP w@ $ BF09 = optimize_branches? and \ is it an ELSE branch? IF \ yes - rather a special case, so we factor it out. branchCDP destCDP resolve_ELSE EXIT THEN destCDP branchCDP - -> offs offs 4 = IF \ this is a branch to the next instruction - \ maybe we can just omit it altogether. destCDP CDP = optimize_branches? and IF [ debug? ] [if] ." conditional branch over nothing - deleting it" cr [then] -4 ++> CDP EXIT \ wipe out the branch, and we're done THEN THEN \ we resolve the branch: offs $ FFFFFFFC and \ &&&&temp while we're testing branchCDP 2+ w! \ now if what we branched over was another branch instruction, we can \ combine them. offs 8 = optimize_branches? and IF branchCDP 4+ w@ \ these are the opcodes for our various \ kinds of unconditional branches: CASE[ $ BF02 ], \ EXIT [ $ BF08 ], \ normal uncond. branch [ $ BF09 ]=> \ ELSE-branch debug? if ." conditional branch over another branch - combining them" cr ." here's the code before we do:" cr dasm then branchCDP combine_branches DEFAULT=> drop ]CASE THEN ; : RESOLVE_UNCONDITIONAL_BRANCH { branchCDP destCDP \ offs -- } \ We only use this for forward definitions and a couple of other \ related things. So we don't do any fancy optimizations. destCDP branchCDP - -> offs offs $ 03FFFFFF and \ uncond branches have 36-bit offset $ 48000000 or branchCDP ! [ ppc? ] [if] branchCDP 4 fix_caches [then] ; endload \ &&& not currently doing this, since we normally have to do some \ register shuffling on return from a call. : TAIL_OPTIMIZE? { \ lookHere inst -- did_it? } false \ CDP 4- -> lookHere \ lookHere c@ 2 >> 18 = 0EXIT \ lookHere @ -> inst \ inst 1 and 0EXIT \ inst 1 xor lookHere ! \ drop true ;